home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr50 / picalc06.zip / PICALC.BAS next >
BASIC Source File  |  1993-06-08  |  12KB  |  338 lines
  1.  REM  -PROGRAM : PICALC -----------------------------------------------
  2.  REM | FUNCTION: COMPUTES THE VALUE OF PI FROM RANDOM NUMBER GENERATOR |
  3.  REM |                                                                 |
  4.  REM | STATUS  : PUBLIC DOMAIN                                         |
  5.  REM |                                                                 |
  6.  REM | BY      : TOM TAYLOR                                            |
  7.  REM |           SIGMA SOFTWARE                                        |
  8.  REM |           50 Bret Avenue                                        |
  9.  REM |           San Rafael, CA 94901                                  |
  10.  REM |           Ph: (415) 457-1071                                    |
  11.  REM |                                                                 |
  12.  REM  -----------------------------------------------------------------
  13.  REM
  14.  PgmName$ = "PICALC"
  15.  PgmVers$ = "0.6"
  16.  PgmDate$ = "03/21/93"
  17.  
  18.  CLS : PRINT "CALCULATION OF PI FROM RANDOM NUMBERS"
  19.  PRINT
  20.  PRINT "PROGRAM: "; PgmName$; "  VERS: "; PgmVers$; " DATE: "; PgmDate$
  21.  PRINT
  22.  PRINT "This program will only terminate in Two ways"
  23.  PRINT " 1. It reaches the Max Number of Iterations (2,147,483,647)."
  24.  PRINT " 2. You get sick of running it and press the <ESC> key."
  25.  PRINT
  26.  PRINT "In either case, the program will print the accumulated value of"
  27.  PRINT "PI at that time and end the run with an appropriate message."
  28.  PRINT "If the PRINT option is on, this final sample WILL be printed."
  29.  PRINT
  30.  PRINT "You may SAMPLE the number of Iterations and the Value of PI"
  31.  PRINT "by hitting any key (other than the <ESC> key) at any time."
  32.  PRINT "If the PRINT Option is on, this sample will NOT be printed."
  33.  PRINT
  34.  PRINT
  35.  PRINT "Hit <ANY-KEY> to continue ....";
  36.  INPUT z$:                              REM wait till user ready
  37.  
  38.  REM *******************************************************************
  39.  REM ***   PROGRAM CONSTANTS, ETC                                    ***
  40.  REM *******************************************************************
  41.  AbsMax& = 2147483647:                  REM ABSOLUTE LIMIT OF PRECISION
  42.  TruePi# = 3.14159265358979#:           REM value of PI to precision
  43.  Fuzz# = 5E-14:                         REM fuzz for single to double
  44.  Hits& = 0:                             REM hits in sector
  45.  SampType% = 1:                         REM default to magnitude
  46.  SampChg% = 10:                         REM default to 10
  47.  SampNext& = 1:                         REM iteration for next sample
  48.  SampPrt% = 0:                          REM printer switch 0=off, 1=on
  49.  ItMask$ = "##,###,###,###":            REM iteration mask
  50.  DPMask$ = "####.#######":              REM delta percent mask
  51.  
  52.  
  53.  REM *******************************************************************
  54.  REM ***   MAIN MENU AND OPTIONS PROCESSING                          ***
  55.  REM *******************************************************************
  56. MainMenu:
  57.  CLS
  58.  PRINT "    PI CALCULATION - MAIN MENU"
  59.  PRINT
  60.  PRINT "1.  AUTOMATIC SAMPLING INTERVAL DEFINITION = ";
  61.     PRINT MID$("NONE     MAGNITUDEMULTIPLES", (SampType% * 9) + 1, 9)
  62.  PRINT "    -  NONE for NO samples"
  63.  PRINT "    -  MAG for samples by magnitude"
  64.  PRINT "           i.e samples at 10, 100, 1000, 10000, ...."
  65.  PRINT "    -  MUL for samples on multiples"
  66.  PRINT "           i.e samples at 100, 200, 300, 400, ...."
  67.  SELECT CASE SampType%
  68.     CASE IS = 1
  69.         PRINT "2.  MAGNITUDE ";
  70.     CASE IS = 2
  71.         PRINT "2.  MULTIPLE ";
  72.     CASE ELSE
  73.  END SELECT
  74.  IF SampType% > 0 THEN
  75.     PRINT "CHANGE FOR AUTOMATIC SAMPLES = "; SampChg%
  76.     PRINT "3.  AUTOMATIC SAMPLES TO PRINTER <Y|N> = ";
  77.         PRINT MID$("NO YES", (SampPrt% * 3) + 1, 3)
  78.  END IF
  79.  PRINT
  80.  PRINT "0.  BEGIN RUN"
  81.  PRINT
  82.  PRINT "    SELECT BY NUMBER ====> "
  83.  
  84.  
  85.  
  86.  REM *******************************************************************
  87.  REM ***   GET MENU ITEM TO BE CHANGED                               ***
  88.  REM *******************************************************************
  89.  
  90.  z$ = ""
  91.  DO WHILE z$ = ""
  92.     z$ = INKEY$
  93.  LOOP
  94.  z$ = UCASE$(z$)
  95.  
  96.  SELECT CASE z$
  97.     CASE IS = "0"
  98.         GOTO SetUpRun
  99.     CASE IS = "1"
  100.         ErrFlg% = 1:            REM assume an error
  101.         DO
  102.             CLS
  103.             PRINT "CHANGE TO AUTOMATIC SAMPLING TYPE "
  104.             PRINT " ENTER - NONE FOR NO AUTOMATIC SAMPLES"
  105.             PRINT "         MAG FOR MAGNITUDE CHANGES"
  106.             PRINT "         MUL FOR MULTIPLE CHANGES"
  107.             PRINT "         <ENTER> TO KEEP PRESENT VALUE"
  108.             PRINT
  109.             PRINT "CURRENT VALUES IS ";
  110.             z% = (SampType% * 4) + 1
  111.                 PRINT MID$("NONEMAG MUL ", z%, 4);
  112.                 PRINT ", ENTER NEW VALUE ";
  113.             INPUT temp$
  114.             temp$ = LEFT$(UCASE$(temp$), 3)
  115.             SELECT CASE temp$
  116.                 CASE IS = ""
  117.                     ErrFlg% = 0
  118.                 CASE IS = "NON"
  119.                     SampType% = 0
  120.                     SampPrt% = 0
  121.                     ErrFlg% = 0
  122.                 CASE IS = "MAG"
  123.                     SampType% = 1
  124.                     ErrFlg% = 0
  125.                 CASE IS = "MUL"
  126.                     SampType% = 2
  127.                     ErrFlg% = 0
  128.                 CASE ELSE
  129.             END SELECT
  130.         LOOP WHILE ErrFlg% = 1
  131.  
  132.     CASE IS = "2"
  133.         IF SampType% = 0 THEN
  134.             CLS
  135.             PRINT "INVALID ENTRY FROM MAIN MENU":   REM no sampling
  136.             SLEEP 15
  137.             GOTO MainMenu
  138.         END IF
  139.  
  140.         ErrFlg% = 1
  141.         DO
  142.             CLS
  143.             PRINT "AUTOMATIC SAMPLES BY ";
  144.             SELECT CASE SampType%
  145.                 CASE IS = 1
  146.                     PRINT "MAGNITUDE"
  147.                     PRINT "  Suggest a power of 2 or a power of 10"
  148.                     PRINT "  Acceptable values are 2 thru 32,767"
  149.                     PRINT "  The iteration number of the previous ";
  150.                         PRINT "sample will be MULTIPLIED by this value."
  151.                     PRINT
  152.                     PRINT "<ENTER> ALONE TO RETAIN CURRENT VALUE"
  153.                     PRINT
  154.                     PRINT "CURRENT VALUE IS "; SampChg%;
  155.                         PRINT ",  ENTER NEW VALUE ";
  156.                     INPUT temp$
  157.                     IF (VAL(temp$) > 1) AND (VAL(temp$) < 32768) THEN
  158.                         SampChg% = VAL(temp$)
  159.                         ErrFlg% = 0
  160.                     ELSE
  161.                         IF LEN(temp$) = 0 THEN
  162.                             ErrFlg% = 0
  163.                         END IF
  164.                     END IF
  165.  
  166.                 CASE IS = 2
  167.                     PRINT "MULTIPLES"
  168.                     PRINT "  Suggest a multiple of a power of 10"
  169.                     PRINT "  Acceptable values are 1 thru 32767"
  170.                     PRINT "  This value will be ADDED to the ";
  171.                         PRINT "iteration number of the previous sample."
  172.                     PRINT
  173.                     PRINT "<ENTER> ALONE TO RETAIN CURRENT VALUE"
  174.                     PRINT
  175.                     PRINT "CURRENT VALUE IS "; SampChg%;
  176.                         PRINT ",  ENTER NEW VALUE ";
  177.                     INPUT temp$
  178.                     IF (VAL(temp$) > 0) AND (VAL(temp$) < 32768) THEN
  179.                         SampChg% = VAL(temp$)
  180.                         ErrFlg% = 0
  181.                     ELSE
  182.                         IF LEN(temp$) = 0 THEN
  183.                             ErrFlg% = 0
  184.                         END IF
  185.                     END IF
  186.  
  187.             END SELECT
  188.         LOOP WHILE ErrFlg% = 1
  189.  
  190.     CASE IS = "3"
  191.         IF SampType% = 0 THEN
  192.             CLS
  193.             PRINT "INVALID ENTRY FROM MAIN MENU":       REM no samples
  194.             SLEEP 15
  195.             GOTO MainMenu
  196.         END IF
  197.        
  198.         ErrFlg% = 1
  199.         DO
  200.             CLS
  201.             PRINT "AUTOMATIC SAMPLES (as well as the final one) ";
  202.                 PRINT "TO THE PRINTER OPTION"
  203.             PRINT "ENTER Y (for yes), or N (for no)"
  204.             PRINT
  205.             PRINT "<ENTER> ALONE TO RETAIN CURRENT VALUE"
  206.             PRINT
  207.             PRINT "CURRENT VALUE IS ";
  208.                 PRINT MID$("NO YES", (SampPrt% * 3) + 1, 3);
  209.                 PRINT ",  ENTER NEW VALUE ";
  210.             INPUT temp$
  211.             temp$ = LEFT$(UCASE$(temp$), 1)
  212.             SELECT CASE temp$
  213.                 CASE IS = ""
  214.                     ErrFlg% = 0
  215.                 CASE IS = "N"
  216.                     SampPrt% = 0
  217.                     ErrFlg% = 0
  218.                 CASE IS = "Y"
  219.                     SampPrt% = 1
  220.                     ErrFlg% = 0
  221.                 CASE ELSE
  222.             END SELECT
  223.         LOOP WHILE ErrFlg% = 1
  224.  END SELECT
  225.  GOTO MainMenu
  226.  
  227.  REM *******************************************************************
  228.  REM ***   SET UP FOR THE RUN                                        ***
  229.  REM *******************************************************************
  230. SetUpRun:
  231.  
  232.  SELECT CASE SampType%
  233.     CASE IS = 0
  234.         SampNext& = AbsMax&
  235.     CASE IS = 1
  236.         SampNext& = 1
  237.     CASE IS = 2
  238.         SampNext& = SampChg%
  239.  END SELECT
  240.  
  241.  CLS
  242.  PRINT " PI COMPUTATION BEGINNING - ON "; DATE$; " AT "; TIME$
  243.  PRINT "    ITERATIONS         COMPUTED VALUE OF PI       DELTA %"
  244.  VIEW PRINT 3 TO 23
  245.  
  246.  IF SampPrt% = 1 THEN
  247.     LPRINT "PROGRAM: "; PgmName$; "  VERS: "; PgmVers$;
  248.         LPRINT " DATE: "; PgmDate$
  249.     LPRINT " PI COMPUTATION BEGINNING - ON "; DATE$; " AT "; TIME$
  250.     LPRINT "    ITERATIONS         COMPUTED VALUE OF PI       DELTA %"
  251.  END IF
  252.  
  253.  RANDOMIZE TIMER
  254.  
  255.  REM *******************************************************************
  256.  REM ***   MAIN COMPUTATION LOOP                                     ***
  257.  REM *******************************************************************
  258.  
  259. MainLoop:
  260.  FOR tries& = 1 TO AbsMax&
  261.     X = RND(1)
  262.     X2# = (X * X) - Fuzz#
  263.  
  264.     Y = RND(1)
  265.     Y2# = (Y * Y) - Fuzz#
  266.    
  267.     r# = SQR(X2# + Y2#) - Fuzz#:                REM vector to point(X,Y)
  268.  
  269.     SELECT CASE r#
  270.         CASE IS < 1#
  271.             Hits& = Hits& + 1:                  REM In the Arc
  272.             GOTO CheckPrint
  273.         CASE IS > 1#
  274.             GOTO CheckPrint:                    REM Outside the Arc
  275.         CASE ELSE
  276.             IF (tries& MOD 2) > 0 THEN
  277.                 Hits& = Hits& + 1
  278.             END IF
  279.             GOTO CheckPrint:                    REM Flip a Coin
  280.     END SELECT
  281.  
  282. CheckPrint:
  283.     Q$ = "": Q$ = INKEY$: IF Q$ <> "" THEN GOTO PrintValues
  284.     IF tries& < SampNext& THEN
  285.         GOTO LoopAgain:  REM KEEP ON TRUCKING
  286.     END IF
  287.  
  288. PrintValues:
  289.     PI# = 4 * (Hits& / tries&):  REM PI IS PROPORTIONAL TO NR OF HITS
  290.     DeltaPct = 100 * ((PI# - TruePi#) / TruePi#)
  291.     PRINT USING (ItMask$); tries&;
  292.         PRINT SPC(8); PI#;
  293.         PRINT TAB(48); USING (DPMask$); DeltaPct
  294.     IF (SampPrt% = 1) AND ((Q$ = "") OR (Q$ = CHR$(27))) THEN
  295.         LPRINT USING (ItMask$); tries&;
  296.             LPRINT SPC(8); PI#;
  297.             LPRINT TAB(48); USING (DPMask$); DeltaPct
  298.     END IF
  299.  
  300.     IF Q$ = "" THEN
  301.         SELECT CASE SampType%
  302.             CASE IS = 1
  303.                 IF (AbsMax& / SampNext&) > SampChg% THEN
  304.                     SampNext& = SampNext& * SampChg%
  305.                 ELSE
  306.                     SampNext& = AbsMax&
  307.                 END IF
  308.             CASE IS = 2
  309.                 IF (AbsMax& - SampNext&) > SampChg% THEN
  310.                     SampNext& = SampNext& + SampChg%
  311.                 ELSE
  312.                     SampNext& = AbsMax&
  313.                 END IF
  314.         END SELECT
  315.         GOTO LoopAgain
  316.     END IF
  317.    
  318.     IF Q$ = CHR$(27) THEN
  319.         PRINT "TERMINATED BY REQUEST - ON "; DATE$; " AT "; TIME$
  320.         IF SampPrt% = 1 THEN
  321.             LPRINT "TERMINATED BY REQUEST - ON "; DATE$; " AT "; TIME$
  322.             LPRINT CHR$(12)
  323.         END IF
  324.         END
  325.     END IF
  326.  
  327. LoopAgain:
  328.  NEXT tries&
  329.  PRINT "TERMINATED AT LIMIT OF PRECISION - ON ";
  330.     PRINT DATE$; " AT "; TIME$
  331.  IF SampPrt% = 1 THEN
  332.     LPRINT "TERMINATED AT LIMIT OF PRECISION - ON ";
  333.         LPRINT DATE$; " AT "; TIME$
  334.     LPRINT CHR$(12)
  335.  END IF
  336.  END
  337.  
  338.